home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / langwn1.exe / SAMPLE01.BAS < prev    next >
BASIC Source File  |  1993-03-20  |  38KB  |  1,240 lines
  1. '============================================================================
  2. '============================================================================
  3.  
  4. ' sample code 01 to demonstrate techniques for using LangWin.
  5.  
  6. ' hit Shift+F5 to run this code.
  7. ' follow instructions displayed in each sample window.
  8.  
  9. ' you must start QuickBASIC as follows:  qb /ah /L langwin
  10. '    /L langwin parameter provides access to LangWin quicklib
  11. '    /ah parameter is needed to allow dynamic arrays > 64k.
  12.  
  13. ' hit F2, then select one of the demo subroutines to examine sample code
  14.  
  15. ' subroutines called to display sample windows
  16. DECLARE SUB demo1 ()
  17. DECLARE SUB demo2 ()
  18. DECLARE SUB demo3 ()
  19. DECLARE SUB demo4 ()
  20. DECLARE SUB demo5 ()
  21. DECLARE SUB demo6 ()
  22.  
  23. DECLARE FUNCTION VidType% ()  ' used to determine type of monitor
  24.  
  25. '  must compile with qb /ah /L langwin
  26.  
  27. '$DYNAMIC  make all arrays dynamic
  28.  
  29. DEFINT A-Z
  30.  
  31. '$INCLUDE: 'LANGWIN.BI' ' TYPE, DECLARE and COMMON definitions for LangWin.
  32. '                         NOTE: LANGWIN.BI contains all definitions found
  33. '                               in QB.BI, so include for QB.BI is not needed.
  34.  
  35.  
  36.  
  37. CLEAR , , 5000   ' set stack at 5000 bytes
  38.  
  39.  
  40. '---------------------------------------------------------------
  41. ' first see if EGA or VGA monitor
  42. mm = VidType
  43. IF mm <> 3 AND mm <> 4 THEN
  44.     ' monitor is not EGA/VGA
  45.     ' take whatever actions necessary (error messages)
  46.     BEEP
  47.     PRINT "LangWin needs EGA or VGA, sorry ........"
  48.     END
  49. END IF
  50.  
  51.  
  52. '-----------------------------------------------------------------
  53. ' get attribute from current screen (row 1, col 1)
  54. ' so it can be restored upon exit
  55. OrigAttr = SCREEN(1, 1, 1)
  56.  
  57. '-------------------------------------------------------------------
  58. ' if WIDTH command is used, it must be placed before call to LangWinInit
  59. ' because code in LangWinInit extracts max rows/cols from screen and saves
  60. ' in global variables. if WIDTH is used after LangWinInit, the global
  61. ' variable will not be set correctly.
  62. WIDTH 80, 25
  63.  
  64. '----------------------------------------------------------------------
  65. ' these variables MUST be defined BEFORE call to LangWinInit.
  66. ' keep these as low as possible to conserve memory at run time.
  67. MaxWindows = 8       ' max simultaneous open windows
  68. MaxButtons = 30      ' max number of objects (incl lines with labels) active
  69. MaxTextLines = 35    ' maximum number of text lines in any scrollable win
  70. MaxTextWins = 5      ' max windows that can have scrollable text
  71.                      ' must be <= MaxWindows
  72.  
  73. LOCATE , , 0         ' start with hidden text cursor
  74.  
  75. '---------------------------------------------------------------------------
  76. ' LangWin only supports text mode. You MUST call the SCREEN 0 command BEFORE
  77. ' the call to LangWinInit. You can call SCREEN with a video page other than 0
  78. ' (i.e., SCREEN 0,,x,x   where x is a page number supported by your system).
  79. ' Code in LangWinInit will determine which video page you are using and save
  80. ' the value in a global variable for use by other LangWin routines. If you
  81. ' call SCREEN 0 after LangWinInit and change the original video page, you'll
  82. ' get unpredictable results (i.e., LangWin will write to the original video
  83. ' page). However, you can use other video pages for functions not associated
  84. ' with your LangWin windows; just be sure to set the video page back to the
  85. ' original value defined below.
  86.  
  87. SCREEN 0, , 0, 0        ' LangWin ONLY supports text mode
  88.                         ' You MUST call the SCREEN command BEFORE LangWinInit
  89.  
  90.  
  91. CALL LangWinInit     ' initialize (if mouse exists, it will be displayed)
  92.               
  93.                      ' if you get "subscript out of range" error while
  94.                      ' in this routine, be sure you called QB with /ah.
  95.                      ' then try reducing the value of MaxWindows.
  96.                      ' check the WIDTH command; reduce number of columns,
  97.                      ' and/or number of rows.
  98.  
  99. '-----------------------------------------------------------------------
  100. ' display "wallpaper"
  101.  
  102. IF HaveMouse THEN CALL HideMouseCursor  ' first hide mouse pointer
  103.  
  104. CLS
  105. CALL SetColor(8, 15)
  106. FOR i = 1 TO MaxRows
  107. LOCATE i, 1
  108. PRINT STRING$(80, 178);     ' can try 176, 177, or 178
  109. NEXT
  110.  
  111. IF HaveMouse THEN CALL ShowMouseCursor   ' display the mouse pointer
  112.  
  113. '====================================================================
  114.  
  115. CALL demo1    ' simple window
  116. CALL demo2    ' add window with buttons
  117. CALL demo3    ' add button that causes child window(s) to be opened
  118. CALL demo4    ' window with input fields & child window
  119. CALL demo5    ' scrollable text windows & child windows
  120. CALL demo6    ' password entry technique
  121.  
  122. '=====================================================================
  123.  
  124.  
  125. IF HaveMouse THEN HideMouseCursor    ' we're done with the mouse
  126.  
  127. bbb = (OrigAttr AND &HF0) \ 16  ' mask & shift to get original background
  128. fff = OrigAttr AND &HF          ' mask to get original foreground
  129.  
  130.  
  131. PALETTE                           ' restore original palette
  132. CALL SetColor(fff, bbb)           ' restore orig foreground/background
  133. CLS
  134. LOCATE , , 1                      ' make text cursor visible
  135.  
  136. END
  137.  
  138. REM $STATIC
  139. '
  140. '  one window opened; it contains info text only.
  141. '  no scrollable text, no buttons.
  142. '  only valid event is 'close'
  143. '  (window can be moved).
  144. '
  145. SUB demo1
  146.  
  147. '=================================================
  148. ' first window: info text only  (w1 contains window's number or error code)
  149. w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1)
  150.  
  151. ' test to see if window was successfully opened
  152. IF w1 < 0 THEN
  153. '  some code to handle the error
  154.     CLS
  155.     PRINT "w1 BlankWin error number: "; w1
  156.     END
  157. END IF
  158.  
  159. ' display some text in the window
  160. d = ShowWinText(2, 2, 0, "Close window to exit")
  161. d = ShowWinText(3, 2, 0, "(double click top/left).")
  162. d = ShowWinText(5, 2, 0, "Drag top/left corner to move.")
  163. ' put a title in window
  164. d = ShowTitle("Info Only Window", 15, 1)
  165. ' no error tests will be made for above functions
  166.  
  167.  
  168. '=============================================================
  169.  
  170.  
  171. ' MAIN LOOP
  172. ' as long as any win is open
  173. ' wait for an event in any window, then process it
  174.  
  175. DO WHILE AnyWinOpen
  176.     ' wait for an event
  177.     ' win number (wn) and event code (action) returned
  178.     wn = WinEvent(action)
  179.  
  180.     ' test window number to see which window was current when event occurred
  181.     SELECT CASE wn
  182.  
  183.     CASE w1      ' first window
  184.         ' now determine what type of event occurred in the window w1
  185.         SELECT CASE action
  186.         CASE 1      ' close
  187.             xx = CloseWindow
  188.         CASE 2      ' text
  189.             ' no scrollable text to select in this win
  190.             ' this case could be omitted
  191.         CASE 3      ' button
  192.             ' no buttons in this win
  193.             ' this case could be omitted
  194.         END SELECT
  195.  
  196.     END SELECT
  197.  
  198.  
  199. LOOP
  200.  
  201. LOCATE 25, 1
  202. CALL SetColor(15, 4)
  203. PRINT "HIT ANY KEY TO CONTINUE DEMO ...";
  204. SLEEP
  205.  
  206. LOCATE 25, 1
  207. CALL SetColor(8, 15)
  208. PRINT STRING$(80, 178);
  209.  
  210. END SUB
  211.  
  212. '
  213. '  this demo adds to the code developed for demo1
  214. '
  215. '  two windows opened:
  216. '  the first has info text only.
  217. '  the second has two buttons:
  218. '  1) beep; 2) exit
  219. '
  220. SUB demo2
  221.  
  222. '=================================================
  223. ' first window: info text only  (w1 contains window's number or error code)
  224. w1 = BlankWin(3, 3, 10, 35, 4, 15, 2, 0, 1, 1)
  225.  
  226. ' test to see if window was successfully opened
  227. IF w1 < 0 THEN
  228. '  some code to handle the error
  229.     CLS
  230.     PRINT "w1 BlankWin error number: "; w1
  231.     END
  232. END IF
  233.  
  234. ' display some text in the window
  235. d = ShowWinText(2, 2, 0, "Close window to exit")
  236. d = ShowWinText(3, 2, 0, "(double click top/left).")
  237. d = ShowWinText(5, 2, 0, "Drag top/left corner to move.")
  238. ' put a title in window
  239. d = ShowTitle("Info Only Window", 15, 1)
  240. ' no error tests will be made for above functions
  241.  
  242.  
  243. '=============================================================
  244. ' second window: text and buttons (w2 contains window's number or error code)
  245. w2 = BlankWin(9, 26, 21, 66, 9, 15, 1, 0, 0, 1)
  246.  
  247. ' test to see if window was successfully opened
  248. IF w2 < 0 THEN
  249. '  some code to handle the error
  250.     CLS
  251.     PRINT "w2 BlankWin error number: "; w2
  252.     END
  253. END IF
  254.  
  255. ' display some text in the window
  256. d = ShowWinText(1, 2, 15, "Click button to exit.")
  257. d = ShowWinT